//**
unit uImage;

interface

uses Graphics, JPEG, GIFImage, PNGImage;

type
  //**
  TImages = array of TBitmap;
  //**
  TImage = class
  private
    //**
    FJPG: TJpegImage;
    //**
    FGIF: TGIFImage;
    //**
    FPNG: TPNGObject;
  public
    //**
    procedure Gamma(Bitmap: TBitmap; L: Double);
    //**
    procedure Scale(Bitmap: TBitmap; Width, Height: Integer);
    //**
    procedure MixColors(Bitmap: TBitmap; Color: Integer);
    //**
    function Load(const APath: string; Bitmap: TBitmap): Boolean;
    //**
    procedure Split(const APath: string; var AImages: TImages; CellSize: Integer; ATransparent: Boolean = False);
  end;

implementation

uses SysUtils, Types;

{ TImage }

procedure TImage.Scale(Bitmap: TBitmap; Width, Height: Integer);
var
  FTemp: TBitmap;
  ARect: TRect;
begin
  FTemp := TBitmap.Create;
  try
    FTemp.Width := Width;
    FTemp.Height := Height;
    ARect := Rect(0, 0, Width, Height);
    FTemp.Canvas.StretchDraw(ARect, Bitmap);
    Bitmap.Assign(FTemp);
  finally
    FTemp.Free;
  end;
end;

procedure TImage.Gamma(Bitmap: TBitmap; L: Double);

  function Power(Base, Exponent: Extended): Extended;
  begin
    Result := Exp(Exponent * Ln(Base));
  end;

type
  TRGB = record
    B, G, R: Byte;
  end;
  pRGB = ^TRGB;

var
  Dest: pRGB;
  X, Y: Word;
  GT: array[0..255] of Byte;

begin
  Bitmap.PixelFormat := pf24Bit;
  GT[0] := 0;
  if L = 0 then L := 0.01;
  for X := 1 to 255 do GT[X] := Round(255 * Power(X / 255, 1 / L));
  for Y := 0 to Bitmap.Height - 1 do
  begin
    Dest := Bitmap.ScanLine[y];
    for X := 0 to Bitmap.Width - 1 do
    begin
      with Dest^ do
      begin
        R := GT[R];
        G := GT[G];
        B := GT[B];
      end;
      Inc(Dest);
    end;
  end;
end;

procedure TImage.MixColors(Bitmap: TBitmap; Color: Integer);
  function GetR(const Color: TColor): Byte;
  begin
    Result := Lo(Color);
  end;

  function GetG(const Color: TColor): Byte;
  begin
    Result := Lo(Color shr 8);
  end;

  function GetB(const Color: TColor): Byte;
  begin
    Result := Lo((Color shr 8) shr 8);
  end;

  function BLimit(B: Integer): Byte;
  begin
    if B < 0 then Result := 0
      else if B > 255 then Result := 255
        else Result := B;
  end;

type
  TRGB = record
    B, G, R: Byte;
  end;

  pRGB = ^TRGB;

var
  r1, g1, b1: Byte;
  x, y: Integer;
  Dest: pRGB;
  A: Double;

begin
   Bitmap.PixelFormat := pf24Bit;
   r1 := Round(255 / 100 * GetR(Color));
   g1 := Round(255 / 100 * GetG(Color));
   b1 := Round(255 / 100 * GetB(Color));
   for y := 0 to Bitmap.Height - 1 do begin
     Dest := Bitmap.ScanLine[y];
     for x := 0 to Bitmap.Width - 1 do begin
       with Dest^ do begin
         A := (r + b + g) / 300;
         with Dest^ do begin
           R := BLimit(Round(r1 * A));
           G := BLimit(Round(g1 * A));
           B := BLimit(Round(b1 * A));
           if (R=255) and (G=255) and (B=255) then
           begin
             R:= 216;
             G:= 212;
             B:= 240;
           end;
         end;
       end;
       Inc(Dest);
     end;
   end;
end;

function TImage.Load(const APath: string; Bitmap: TBitmap): Boolean;

  function FileExt: string;
  begin
    Result := Copy(APath, Length(APath) - 3, Length(APath));
  end;

begin
  Result := False;
  if FileExists(APath) then
  begin
    if (LowerCase(FileExt) = '.bmp') then
    begin
      Result := True;
      Bitmap.LoadFromFile(APath);
    end else
    if (LowerCase(FileExt) = '.png') then
    begin
      Result := True;
      FPNG := TPNGObject.Create;
      try
        FPNG.LoadFromFile(APath);
        Bitmap.Assign(FPNG);
      finally
        FPNG.Free;
      end;
    end else
    if (LowerCase(FileExt) = '.jpg') then
    begin
      Result := True;
      FJPG := TJpegImage.Create;
      try
        FJPG.LoadFromFile(APath);
        Bitmap.Assign(FJPG);
      finally
        FJPG.Free;
      end;
    end else
    if (LowerCase(FileExt) = '.gif') then
    begin
      Result := True;
      FGIF := TGIFImage.Create;
      try
        FGIF.LoadFromFile(APath);
        Bitmap.Assign(FGIF);
      finally
        FGIF.Free;
      end;
    end;
  end;
end;

procedure TImage.Split(const APath: string; var AImages: TImages; CellSize: Integer; ATransparent: Boolean = False);
var
  I, J, U: Integer;
  FTemp: TBitmap;
begin
  FTemp := Graphics.TBitmap.Create;
  try
    Load(APath, FTemp);
    SetLength(AImages, (FTemp.Width div CellSize) * (FTemp.Height div CellSize));
    for I := 0 to Length(AImages) - 1 do AImages[I] := TBitmap.Create;
    U := 0;
    for J := 0 to (FTemp.Height div CellSize) - 1 do
    for I := 0 to (FTemp.Width div CellSize) - 1 do
    with AImages[U] do
    begin
      Width := CellSize;
      Height := CellSize;
      PixelFormat := pf24Bit;
      Canvas.CopyRect(Bounds(0, 0, CellSize, CellSize), FTemp.Canvas,
        Bounds(I * CellSize, J * CellSize, CellSize, CellSize));
      Inc(U);
    end;
    if ATransparent then
    for I := 0 to High(AImages) do
    begin
      AImages[I].TransparentColor := AImages[I].Canvas.Pixels[1, 1];
      AImages[I].Transparent := True;
    end;
  finally
    FTemp.Free;
  end;
end;

end.
